home *** CD-ROM | disk | FTP | other *** search
/ Programmer Plus 2007 / Programmer-Plus-2007.iso / Programming / Borland Plateform / Turbo Pascal V7.0 / DOCDEMO.ZIP / DRAGS.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-10-30  |  4.0 KB  |  163 lines
  1. {************************************************}
  2. {                                                }
  3. {   Turbo Vision 2.0 Demo                        }
  4. {   Copyright (c) 1992 by Borland International  }
  5. {                                                }
  6. {************************************************}
  7.  
  8. program Drags;
  9.  
  10. uses Objects, Views, App, Drivers, Dialogs, Menus;
  11.  
  12. type
  13.   PDragDialog = ^TDragDialog;
  14.   TDragDialog = object(TDialog)
  15.     constructor Init;
  16.   end;
  17.   TFlagRecord = record
  18.     DragFlags, GrowFlags: Word;
  19.   end;
  20.   PDragBlock = ^TDragBlock;
  21.   TDragBlock = object(TView)
  22.     Flags: TFlagRecord;
  23.     constructor Init;
  24.     procedure Draw; virtual;
  25.     procedure HandleEvent(var Event: TEvent); virtual;
  26.   end;
  27.   PDragWindow = ^TDragWindow;
  28.   TDragWindow = object(TWindow)
  29.     constructor Init;
  30.   end;
  31.   TDragApp = object(TApplication)
  32.     constructor Init;
  33.     procedure InitStatusLine; virtual;
  34.   end;
  35.  
  36. constructor TDragDialog.Init;
  37. var
  38.   R: TRect;
  39.   DragFlags, GrowFlags: PCheckBoxes;
  40. begin
  41.   R.Assign(0, 0, 41, 11);
  42.   inherited Init(R, 'Set drag/grow flags');
  43.   Options := Options or ofCentered;
  44.   R.Assign(2, 3, 19, 7);
  45.   DragFlags := New(PCheckBoxes, Init(R,
  46.     NewSItem('dmLimitLoX',
  47.     NewSItem('dmLimitLoY',
  48.     NewSItem('dmLimitHiX',
  49.     NewSItem('dmLimitHiY', nil))))));
  50.   Insert(DragFlags);
  51.   R.Assign(1, 2, 12, 3);
  52.   Insert(New(PLabel, Init(R, '~D~rag mode', DragFlags)));
  53.   R.Assign(22, 3, 39, 7);
  54.   GrowFlags := New(PCheckBoxes, Init(R,
  55.     NewSItem('gfGrowLoX',
  56.     NewSItem('gfGrowLoY',
  57.     NewSItem('gfGrowHiX',
  58.     NewSItem('gfGrowHiY', nil))))));
  59.   Insert(GrowFlags);
  60.   R.Assign(21, 2, 32, 3);
  61.   Insert(New(PLabel, Init(R, '~G~row mode', GrowFlags)));
  62.   R.Assign(5, 8, 15, 10);
  63.   Insert(New(PButton, Init(R, 'O~k~', cmOK, bfDefault)));
  64.   R.Assign(24, 8, 34, 10);
  65.   Insert(New(PButton, Init(R, 'Cancel', cmCancel, bfNormal)));
  66.   SelectNext(False);
  67. end;
  68.  
  69. constructor TDragBlock.Init;
  70. var
  71.   R: TRect;
  72. begin
  73.   R.Assign(5, 5, 25, 10);
  74.   inherited Init(R);
  75.   DragMode := dmLimitAll;
  76.   Flags.DragFlags := (DragMode shr 4) and $0F;
  77.   Flags.GrowFlags := GrowMode and gfGrowAll;
  78. end;
  79.  
  80. procedure TDragBlock.Draw;
  81. var
  82.   B: TDrawBuffer;
  83. begin
  84.   MoveChar(B, ' ', GetColor(4), Size.X);
  85.   WriteLine(0, 0, Size.X, Size.Y, B);
  86. end;
  87.  
  88. procedure TDragBlock.HandleEvent(var Event: TEvent);
  89. var
  90.   R: TRect;
  91.   Min, Max: TPoint;
  92. begin
  93.   inherited HandleEvent(Event);
  94.   if Event.What and evMouseDown = evMouseDown then
  95.   begin
  96.     if Event.Double then
  97.     begin
  98.       if Application^.ExecuteDialog(New(PDragDialog, Init), @Flags) <> cmCancel then
  99.       begin
  100.         DragMode := Flags.DragFlags shl 4;
  101.         GrowMode := Flags.GrowFlags;
  102.       end;
  103.     end
  104.     else
  105.     begin
  106.       Owner^.GetExtent(R);
  107.       R.Grow(-1, -1);
  108.       SizeLimits(Min, Max);
  109.       case Event.Buttons of
  110.         mbLeftButton:
  111.           begin
  112.             DragView(Event, dmDragMove or DragMode, R, Min, Max);
  113.             ClearEvent(Event);
  114.           end;
  115.         mbRightButton:
  116.           begin
  117.             DragView(Event, dmDragGrow or DragMode, R, Min, Max);
  118.             ClearEvent(Event);
  119.           end;
  120.       end;
  121.     end;
  122.   end;
  123. end;
  124.  
  125. constructor TDragWindow.Init;
  126. var
  127.   R: TRect;
  128.   DragBlock: PDragBlock;
  129. begin
  130.   Desktop^.GetExtent(R);
  131.   inherited Init(R, 'Drag Window', wnNoNumber);
  132.   DragBlock := New(PDragBlock, Init);
  133.   if Application^.ValidView(DragBlock) <> nil then Insert(DragBlock);
  134. end;
  135.  
  136. constructor TDragApp.Init;
  137. var
  138.   DragWindow: PDragWindow;
  139. begin
  140.   inherited Init;
  141.   DragWindow := New(PDragWindow, Init);
  142.   InsertWindow(DragWindow);
  143. end;
  144.  
  145. procedure TDragApp.InitStatusLine;
  146. var
  147.   R: TRect;
  148. begin
  149.   GetExtent(R);
  150.   R.A.Y := R.B.Y - 1;
  151.   StatusLine := New(PStatusLine, Init(R, NewStatusDef(0, $FFFF,
  152.     NewStatusKey('Drag block, double-click to change flags, or ~Alt+X~ to exit', kbAltX, cmQuit,
  153.     StdStatusKeys(nil)), nil)));
  154. end;
  155.  
  156. var
  157.   DragApp: TDragApp;
  158. begin
  159.   DragApp.Init;
  160.   DragApp.Run;
  161.   DragApp.Done;
  162. end.
  163.